Skip to main content

RAJ 2022 Introduction Course

Kapitel 6 Textvergleich

6.1 Programi

Nameščanje programov (Packages) Namestitev: Če ste program(e) že namestili, lahko preskočite ta korak.

Znak # v programskem bloku (chunk) pomeni, da se ta vrstica ne izvaja. Odstrani # če želite program namestiti.

# # Programe, ki jih še nimate, lahko namestite tudi na ta način (odstranite #):
# install.packages("readtext")
# install.packages("quanteda")
# install.packages("quanteda.textstats")
# install.packages("quanteda.textplots")
# install.packages("tidyverse")
# install.packages("wordcloud2")
# install.packages("tidytext")
# install.packages("udpipe")
# install.packages("janitor")
# install.packages("scales")
# install.packages("widyr")
# install.packages("syuzhet")
# install.packages("corpustools")

Najprej moramo zagnati programe, ki jih potrebujemo za načrtovano delo.

## Warning: package 'quanteda' was built under R version 4.1.1
## Package version: 3.1.0
## Unicode version: 13.0
## ICU version: 69.1
## Parallel computing: 12 of 12 threads used.
## See https://quanteda.io for tutorials and examples.
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.3     v dplyr   1.0.7
## v tidyr   1.1.3     v stringr 1.4.0
## v readr   2.0.1     v forcats 0.5.1
## Warning: package 'readr' was built under R version 4.1.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## 
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test
## 
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor
## Warning: package 'widyr' was built under R version 4.1.1
## 
## Attaching package: 'syuzhet'
## The following object is masked from 'package:scales':
## 
##     rescale
## 
## Attaching package: 'corpustools'
## The following object is masked from 'package:tidytext':
## 
##     get_stopwords

6.2 Preberemo besedila 

txt = readtext("data/books/*.txt", encoding = "UTF-8")
txt
## readtext object consisting of 2 documents and 0 docvars.
## # Description: df [2 x 2]
##   doc_id      text               
##   <chr>       <chr>              
## 1 prozess.txt "\"Der Prozes\"..."
## 2 tom.txt     "\"Tom Sawyer\"..."

Alternativno lahko besedila preberemo tudi z medmrežja:

txt1 = readtext("https://raw.githubusercontent.com/tpetric7/tpetric7.github.io/main/data/books/prozess.txt", encoding = "UTF-8")
txt2 = readtext("https://raw.githubusercontent.com/tpetric7/tpetric7.github.io/main/data/books/tom.txt", encoding = "UTF-8")

# Datoteki združimo
txt = rbind(txt1,txt2)

6.3 Ustvarimo korpus

Ustvarimo korpus ali jezikovno gradivo. Ukaz v programu “quanteda” je corpus().

romane = corpus(txt)

Povzetek:

Program quanteda ima dve funkciji za povzemanje: - summary() - textstat_summary()

(romanstatistik = textstat_summary(romane)
)
##      document  chars sents tokens types puncts numbers symbols urls tags emojis
## 1 prozess.txt 482722  3845  88010  7907  16380      10       0    0    0      0
## 2     tom.txt 460249  4652  85841  9860  18785       9       0    0    0      0
povzetek = summary(romane)
povzetek
## Corpus consisting of 2 documents, showing 2 documents:
## 
##         Text Types Tokens Sentences
##  prozess.txt  8507  88010      3845
##      tom.txt 10551  85841      4652

Podatke iz povzetka bi lahko uporabili npr. za izračun povprečne dolžine povedi v besedilih:

povzetek %>% 
  group_by(Text) %>%
  mutate(dolzina_povedi = Tokens/Sentences)
## # A tibble: 2 x 5
## # Groups:   Text [2]
##   Text        Types Tokens Sentences dolzina_povedi
##   <chr>       <int>  <int>     <int>          <dbl>
## 1 prozess.txt  8507  88010      3845           22.9
## 2 tom.txt     10551  85841      4652           18.5

Lahko bi tudi izračunali kazalnik slovarske raznolikosti v besedilih, tj. razmerje med različnimi (types) in pojavnicami (tokens), kar se angleščini imenuje “type token ratio” (ttr).

Razlikujemo med slovarskimi enotami (lemma), različnicami (types) in pojavnicami (tokens):

npr. nemški glagol “gehen” je slovarska enota, ki ima več različnic ali oblik (npr. gehe, gehst, geht, gehen, geht, ging, gingst, … gegangen).

Pojavnice: nekatere oblike glagola so pogostejše kot druge, nekatere pa se v izbranem besedilu ne pojavljajo.

povzetek %>% 
  group_by(Text) %>% 
  mutate(ttr = Types/Tokens)
## # A tibble: 2 x 5
## # Groups:   Text [2]
##   Text        Types Tokens Sentences    ttr
##   <chr>       <int>  <int>     <int>  <dbl>
## 1 prozess.txt  8507  88010      3845 0.0967
## 2 tom.txt     10551  85841      4652 0.123

Program quanteda ima za ugotavljanje slovarske raznolikosti (lexical diversity) več možnosti, kar zahteva razcepitev besedil na manjše enote, tj. tokens (besede, ločila idr.). Za nekatere funkcije moramo ustvariti besedilno matriko (document frequency matrix, dfm).

6.4 Tokenizacija

Če želimo več izvedeti o besedilih, npr. katere besede se pojavljajo v besedilih, moramo najprej ustvariti seznam besedilnih enot (tj. besed, ločil idr.).

Iz gradiva izvlečemo besedne oblike (npr. s pomočjo presledkov).

Za tokenizacijo ima quanteda ukaz tokens().

besede = tokens(romane)
head(besede)
## Tokens consisting of 2 documents.
## prozess.txt :
##  [1] "Der"                 "Prozess"             "by"                 
##  [4] "Franz"               "Kafka"               "Aligned"            
##  [7] "by"                  ":"                   "bilingual-texts.com"
## [10] "("                   "fully"               "reviewed"           
## [ ... and 87,998 more ]
## 
## tom.txt :
##  [1] "Tom"           "Sawyer"        "by"            "Mark"         
##  [5] "Twain"         "Aligned"       "by"            ":"            
##  [9] "András"        "Farkas"        "("             "autoalignment"
## [ ... and 85,829 more ]

6.5 Čiščenje

S seznama lahko izločimo “nebesede”:

besede = tokens(romane, remove_punct = T, remove_symbols = T, remove_numbers = T, remove_url = T)
head(besede)
## Tokens consisting of 2 documents.
## prozess.txt :
##  [1] "Der"                 "Prozess"             "by"                 
##  [4] "Franz"               "Kafka"               "Aligned"            
##  [7] "by"                  "bilingual-texts.com" "fully"              
## [10] "reviewed"            "Der"                 "Prozess"            
## [ ... and 71,608 more ]
## 
## tom.txt :
##  [1] "Tom"           "Sawyer"        "by"            "Mark"         
##  [5] "Twain"         "Aligned"       "by"            "András"       
##  [9] "Farkas"        "autoalignment" "Source"        "Project"      
## [ ... and 67,035 more ]

Izločimo lahko tudi besede, ki za vsebinsko analizo niso zaželene (“stopwords”).

V izbranih besedilih motijo tudi angleške besede, ki niso sestavni del nemških besedil.

concatenate = združi: c()

stoplist_de = c(stopwords("de"), "dass", "Aligned", "by", "autoalignment", "Source", "Project", 
                "bilingual-texts.com", "fully", "reviewed")
besede = tokens_select(besede, pattern = stoplist_de, selection = "remove")

Naslednji seznam bomo uporabljali za ustvarjanje konkordance, tj. seznama sobesedil, v katerem se nahaja iskalni niz (npr. neka beseda).

stoplist_en = c("Aligned", "by", "autoalignment", "Source", "Project", 
                "bilingual-texts.com", "fully", "reviewed")

# Obdržali bomo ločila
woerter = tokens(romane, remove_symbols = T, remove_numbers = T, remove_url = T)
# Odstranili bomo angleške besede na začetku besedil
woerter = tokens_select(woerter, pattern = stoplist_en, selection = "remove", padding = TRUE)

6.6 Kwic

Za sestavo konkordanc ima program quanteda funkcijo kwic() (keyword in context).

Možno je iskati posamezne besede, besedne zveze, uporabljamo pa lahko tudi nadomestne znake (npr. *).

kwic(woerter, pattern = c("Frau", "Herr")) %>% head(3)
## Keyword-in-context with 3 matches.                                                          
##  [prozess.txt, 22] Kafka Verhaftung, Gespräch mit | Frau |
##  [prozess.txt, 54]      verhaftet. Die Köchin der | Frau |
##  [prozess.txt, 96] seinem Kopfkissen aus die alte | Frau |
##                                    
##  Grubach, dann Fräulein Brüstner   
##  Grubach, seiner Zimmervermieterin,
##  , die ihm gegenüber wohnte

Konkordanco bomo pretvorili v podatkovno zbirko, tj. data.frame ali tibble(). Prednost je npr., da tako pridobimo imena stolpcev (tj. spremenljivk).

kwic() ima več možnosti, npr. “case_insensitive = FALSE” razlikuje med velikimi in malimi črkami. Privzeta vrednost je “TRUE”, tj. da tega ne razlikuje (tako kot Excel).

konkordanca = kwic(woerter, pattern = c("Frau", "Herr"), case_insensitive = FALSE) %>% 
  as_tibble()

konkordanca %>% rmarkdown::paged_table()

Z ukazom count() lahko preštejemo, koliko pojavnic je KWIC našel.

konkordanca %>% 
  count(keyword)
## # A tibble: 2 x 2
##   keyword     n
##   <chr>   <int>
## 1 Frau      132
## 2 Herr       94

Poiskati želimo besede s pripono “-in” za samostalnike, ki označujejo ženska osebna imena (npr. Ärztin, Köchin, …).

(konkordanca2 = kwic(woerter, pattern = c("*in"), case_insensitive = FALSE) %>% 
  as_tibble()
)
## # A tibble: 4,100 x 7
##    docname      from    to pre                           keyword  post   pattern
##    <chr>       <int> <int> <chr>                         <chr>    <chr>  <fct>  
##  1 prozess.txt    26    26 mit Frau Grubach , dann       Fräulein Brüst~ *in    
##  2 prozess.txt    52    52 eines Morgens verhaftet . Die Köchin   der F~ *in    
##  3 prozess.txt    58    58 der Frau Grubach , seiner     Zimmerv~ , die~ *in    
##  4 prozess.txt    86    86 . K . wartete noch            ein      Weilc~ *in    
##  5 prozess.txt   129   129 . Sofort klopfte es und       ein      Mann ~ *in    
##  6 prozess.txt   134   134 ein Mann , den er             in       diese~ *in    
##  7 prozess.txt   143   143 niemals gesehen hatte , trat  ein      . Er ~ *in    
##  8 prozess.txt   155   155 fest gebaut , er trug         ein      anlie~ *in    
##  9 prozess.txt   292   292 zur Tür , die er              ein      wenig~ *in    
## 10 prozess.txt   322   322 das Frühstück bringt . «      Ein      klein~ *in    
## # ... with 4,090 more rows

Žal vsebuje gornji seznam sobesedil veliko besednih oblik, ki niso ženska osebna imena (npr. ein, in, …). Če želimo natančnejši seznam, moramo iskati na ustreznejši način, npr. z naborom nadomestnih znakov, tako imeovanih regularnih izrazov (regular expressions, “regex”).

Na portalu https://regex101.com/ lahko preizkušate in se učite regularnih izrazov.

Poizvedovanje s pomočjo regularnih izrazov: *in.

konkordanca2 = kwic(woerter, pattern = "\\A[A-Z][a-z]+[^Eae]in\\b",
                      valuetype = "regex", case_insensitive = FALSE) %>% 
  as_tibble() %>% 
  filter(keyword != "Immerhin", 
         keyword != "Darin",
         keyword != "Termin",
         keyword != "Worin",
         keyword != "Robin",
         keyword != "Medizin",
         keyword != "Austin",
         keyword != "Musselin",
         keyword != "Benjamin",
         keyword != "Franklin")

konkordanca2 %>% rmarkdown::paged_table()

Še drug primer uporabe regularnih izrazov Poizvedovanje s pomočjo regex: Manjšalnice / Diminutive (-chen, -lein). Katera manjšalna pripona prevladuje: -lein ali -chen ?

(konkordanca3a = kwic(woerter, "*lein",
                      valuetype = "glob", case_insensitive = FALSE) %>% 
  as_tibble() %>% 
   count(keyword, sort = TRUE)
)
## # A tibble: 6 x 2
##   keyword                      n
##   <chr>                    <int>
## 1 Fräulein                   112
## 2 allein                      49
## 3 klein                       10
## 4 Allein                       2
## 5 Äuglein                      1
## 6 Schreibmaschinenfräulein     1
(konkordanca3b <- kwic(woerter, "*chen",
                      valuetype = "glob", case_insensitive = FALSE) %>% 
  as_tibble() %>% 
   count(keyword, sort = T)
)
## # A tibble: 415 x 2
##    keyword      n
##    <chr>    <int>
##  1 machen     125
##  2 Mädchen    100
##  3 sprechen    57
##  4 bißchen     44
##  5 zwischen    43
##  6 solchen     38
##  7 Weilchen    33
##  8 Zeichen     31
##  9 Menschen    30
## 10 Burschen    28
## # ... with 405 more rows
(konkordanca3 <- kwic(woerter, 
                      pattern = c("\\A[A-Z][a-z]*[^aäeiouürs]chen\\b",
                                  "[A-Z]*[^kl]lein\\b"),
                      valuetype = "regex", case_insensitive = FALSE) %>% 
  as_tibble() %>% 
  filter(keyword != "Welchen", 
         keyword != "Manchen",
         keyword != "Solchen",
         keyword != "Fräulein")
)
## # A tibble: 74 x 7
##    docname      from    to pre                         keyword  post    pattern 
##    <chr>       <int> <int> <chr>                       <chr>    <chr>   <fct>   
##  1 prozess.txt    87    87 K . wartete noch ein        Weilchen , sah ~ "\\A[A-~
##  2 prozess.txt   750   750 warf das Buch auf ein       Tischch~ und st~ "\\A[A-~
##  3 prozess.txt  1740  1740 aufgeschreckt , die bei dem Tischch~ am off~ "\\A[A-~
##  4 prozess.txt  2617  2617 , stand K . ein             Weilchen lang s~ "\\A[A-~
##  5 prozess.txt  3323  3323 Stuhl und hielt ihn ein     Weilchen mit be~ "\\A[A-~
##  6 prozess.txt  3624  3624 hatte . Jetzt war das       Nachtti~ von ih~ "\\A[A-~
##  7 prozess.txt  3799  3799 Gegenstände , die auf dem   Nachtti~ lagen ~ "\\A[A-~
##  8 prozess.txt  5805  5805 sagte K . nach einem        Weilchen und re~ "\\A[A-~
##  9 prozess.txt  6952  6952 , das früh auf dem          Tischch~ beim F~ "\\A[A-~
## 10 prozess.txt 10539 10539 . » Darf ich das            Nachtti~ von Ih~ "\\A[A-~
## # ... with 64 more rows

Poizvedovanje s pomočjo “regex”: Frau + Priimek / Ime

Obvezno nastavimo case_insensitive = FALSE, saj naj program razlikuje med velikimi in malimi začetnicami.

(konkordanca4 <- kwic(woerter, pattern = phrase("\\bFrau\\b ^[A-Z][^[:punct:]]"), 
                      valuetype = "regex", case_insensitive = FALSE) %>% 
  as_tibble()
)
## # A tibble: 61 x 7
##    docname      from    to pre            keyword   post           pattern      
##    <chr>       <int> <int> <chr>          <chr>     <chr>          <fct>        
##  1 prozess.txt    22    23 Kafka Verhaft~ Frau Gru~ , dann Fräule~ "\\bFrau\\b ~
##  2 prozess.txt    54    55 verhaftet . D~ Frau Gru~ , seiner Zimm~ "\\bFrau\\b ~
##  3 prozess.txt   416   417 im Nebenzimme~ Frau Gru~ diese Störung~ "\\bFrau\\b ~
##  4 prozess.txt   551   552 Es war das Wo~ Frau Gru~ , vielleicht ~ "\\bFrau\\b ~
##  5 prozess.txt   700   701 . » Ich will ~ Frau Gru~ - « , sagte K  "\\bFrau\\b ~
##  6 prozess.txt  1647  1648 gerade die ge~ Frau Gru~ wollte dort e~ "\\bFrau\\b ~
##  7 prozess.txt  2868  2869 war , so konn~ Frau Gru~ als Zeugin fü~ "\\bFrau\\b ~
##  8 prozess.txt  5960  5961 . Im Vorzimme~ Frau Gru~ , die gar nic~ "\\bFrau\\b ~
##  9 prozess.txt  6557  6558 in der ganzen~ Frau Gru~ verursacht wo~ "\\bFrau\\b ~
## 10 prozess.txt  6852  6853 , aber da er ~ Frau Gru~ sprechen woll~ "\\bFrau\\b ~
## # ... with 51 more rows

6.7 Pogostnost

Besedilno-besedna matrika (dfm) je izhodišče za izračun in grafični prikaz več statističnih količin, npr. tudi pogostnosti besednih oblik v posameznih besedilih:

matrika = dfm(besede, tolower = FALSE) # za zdaj obdržimo velike začetnice

# Odstranimo besede, ki jih v vsebinski analizi ne potrebujemo (stopwords)
matrika = dfm_select(matrika, selection = "remove", pattern = stoplist_de)
matrika
## Document-feature matrix of: 2 documents, 15,185 features (39.73% sparse) and 0 docvars.
##              features
## docs          Prozess Franz Kafka Verhaftung Gespräch Frau Grubach Fräulein
##   prozess.txt       2    24     2         18       16  114      50      112
##   tom.txt           0     0     0          0        4   18       0        0
##              features
## docs          Brüstner Jemand
##   prozess.txt        1      2
##   tom.txt            0      1
## [ reached max_nfeat ... 15,175 more features ]

Program quanteda ima posebno funkcijo, ki sestavi seznam besednih oblik in njihove pogostnosti, tj. textstat_frequency().

library(quanteda.textstats)
library(quanteda.textplots)

pogostnost = textstat_frequency(matrika, groups = c("prozess.txt", "tom.txt"))

pogostnost %>% rmarkdown::paged_table()

Diagram najpogostnejših izrazov:

pogostnost %>% 
  slice_max(order_by = frequency, n = 20) %>% 
  mutate(feature = reorder_within(feature, frequency, frequency, sep = ": ")) %>%
  # ggplot(aes(frequency, reorder(feature, frequency))) +
  ggplot(aes(frequency, feature)) +
  geom_col(fill="steelblue") +
  labs(x = "Frequency", y = "") +
  facet_wrap(~ group, scales = "free")

Po potrebi lahko seznam besednih pogostnosti oblik razdelimo na dva posebna seznama, in sicer s funkcijo filter().

pogost_tom = textstat_frequency(matrika, groups = c("prozess.txt", "tom.txt")) %>% 
  filter(group == "tom.txt")

pogost_tom %>% rmarkdown::paged_table()
pogost_prozess = textstat_frequency(matrika, groups = c("prozess.txt", "tom.txt")) %>% 
  filter(group == "prozess.txt")

pogost_prozess %>% rmarkdown::paged_table()

Glagoli rekanja in mišljenja: kateri so v izbranih besedilih pogostnejši?

sagen = pogostnost %>%
   filter(str_detect(feature, "^(ge)?sag*"))
sagen %>% rmarkdown::paged_table()
reden = pogostnost %>% 
    filter(str_detect(feature, "^(ge)?rede*"))
reden %>% rmarkdown::paged_table()
fragen = pogostnost %>% 
    filter(str_detect(feature, "^(ge)?frag*"))
fragen %>% rmarkdown::paged_table()
antworten = pogostnost %>% 
    filter(str_detect(feature, "^(ge)?antwort*"))
antworten %>% rmarkdown::paged_table()
rufen = pogostnost %>% 
    filter(str_detect(feature, pattern = "^(ge)?ruf*", negate = FALSE)) %>% 
    filter(!str_detect(feature, "ruh|run|rum|rui|ruch"))
rufen %>% rmarkdown::paged_table()
verb1 = sagen %>% 
  group_by(group) %>% 
  summarise(freq = sum(frequency)) %>% 
  mutate(verb = "sagen")

verb2 = reden %>% 
  group_by(group) %>% 
  summarise(freq = sum(frequency)) %>% 
  mutate(verb = "reden")

verb3 = fragen %>% 
  group_by(group) %>% 
  summarise(freq = sum(frequency)) %>% 
  mutate(verb = "fragen")

verb4 = antworten %>% 
  group_by(group) %>% 
  summarise(freq = sum(frequency)) %>% 
  mutate(verb = "antworten")

verb5 = rufen %>% 
  group_by(group) %>% 
  summarise(freq = sum(frequency)) %>% 
  mutate(verb = "rufen")

Pet majhnih tabel lahko združimo v večjo tabelo, tj. s funkcijo rbind().

glagoli = rbind(verb1, verb2, verb3, verb4, verb5)
glagoli %>% rmarkdown::paged_table()

Še diagram:

glagoli %>% 
  ggplot(aes(freq, verb, fill = verb)) +
  geom_col() +
  facet_wrap(~ group) +
  theme(legend.position = "none")

Tabelo lahko tudi prerazporedimo, npr. zaradi lažje primerjave besedil takole:

glagoli %>% 
  pivot_wider(id_cols = verb, names_from = group, values_from = freq) %>% rmarkdown::paged_table()

6.8 Kolokacije

Koleksemi = slovarske enote, ki se sopojavljajo. Kolokacije = jezikovne prvine, ki se sopojavljajo.

Statistična opredelitev: Če se dva izraza (npr. “dober dan”) pojavljata bistveno pogosteje kot neposredna soseda, kakor bi naključno pričakovali, potem ju lahko obravnavamo kot kolokacijo.

Jezikoslovna opredelitev: Kolokacija je pomensko povezano zaporedje besed.

Funkcija textstat_collocations() v programu quanteda.

“woerter” je seznam besednih oblik (padding = TRUE !), ki smo ga ustvarili zgoraj.

coll_2 = textstat_collocations(woerter, size = 2, tolower = TRUE) # naredi male črke !

coll_2 %>% rmarkdown::paged_table()

Kolokacije s tremi členi.

coll_3 = textstat_collocations(woerter, size = 3, tolower = FALSE)

coll_3 %>% rmarkdown::paged_table()
coll_4 = textstat_collocations(woerter, size = 4, tolower = FALSE)

coll_4 %>% rmarkdown::paged_table()

Sopomenski vprašalnici “warum” in "wieso: s katerimi besednimi oblikami se sopojavljata?

warum <- coll_2 %>% 
  filter(str_detect(collocation, "^warum"))
warum %>% rmarkdown::paged_table()
wieso <- coll_2 %>% 
  filter(str_detect(collocation, "^wieso"))
wieso %>% rmarkdown::paged_table()

Kolokacija samostalniških izrazov. V nemščini imajo veliko začetnico. Najprej bomo sestavili seznam besednih oblik z veliko začetnico (woerter_caps). Potem lahko pridobimo seznam kolokacij (coll_caps2).

woerter_caps = tokens_select(woerter, pattern = "^[A-Z]", 
                                valuetype = "regex", 
                                case_insensitive = FALSE, 
                                padding = TRUE)

coll_caps2 = textstat_collocations(woerter_caps, size = 2, tolower = FALSE, min_count = 5)

coll_caps2 %>% rmarkdown::paged_table()

Ni smiselno upoštevati “Der + samostalnik” kot kolokacijo, saj se v nemščini velika večina samostalnikov pojavlja s členom.

Zato bomo člene “Der, Die, Das” in še nekaj besednih oblik na začetku stavka spremenili v “der, die , das”, ….

woerter_small = tokens_replace(woerter, 
                               pattern = c("Der","Die","Das","Des","Wollen","Im","Zum",
                                           "Kein","Jeden","Wenn","Als","Da","Aber","Und","Sehen"), 
                               replacement = c("der","die","das","des","wollen","im","zum",
                                               "kein","jeden","wenn","als","da","aber","und","sehen"))

woerter_caps = tokens_select(woerter_small, pattern = "^[A-Z]", 
                                valuetype = "regex", 
                                case_insensitive = FALSE, 
                                padding = TRUE)

coll_caps2 = textstat_collocations(woerter_caps, size = 2, tolower = FALSE, min_count = 5)

coll_caps2 %>% rmarkdown::paged_table()

6.9 Lematizacija

Seznam slovarskih enot (lem) lahko naložimo z medmrežja na naš disk.

# Preberi seznam slovarskih enot in pojavnic z diska
lemdict = read.delim2("data/lemmatization_de.txt", sep = "\t", encoding = "UTF-8", 
                      col.names = c("lemma", "word"), stringsAsFactors = F)

# Pretvori podatkovna niza v znakovna niza
lemma = as.character(lemdict$lemma) 
word = as.character(lemdict$word)

# Lematiziraj pojavnice v naših besedilih
lemmas <- tokens_replace(besede,
                             pattern = word,
                             replacement = lemma,
                             case_insensitive = TRUE, 
                             valuetype = "fixed")

Ustvarimo matriko s slovarskimi enotami (namesto pojavnic).

matrika_lem = dfm(lemmas, tolower = FALSE) # za zdaj obdržimo velike začetnice

# Odstranimo besede, ki jih v vsebinski analizi ne potrebujemo (stopwords)
matrika_lem = dfm_select(matrika_lem, selection = "remove", pattern = stoplist_de)
matrika_lem
## Document-feature matrix of: 2 documents, 10,072 features (38.04% sparse) and 0 docvars.
##              features
## docs          Prozess franzen Kafka Verhaftung Gespräch Frau Grubach Fräulein
##   prozess.txt       2      24     2         19       18  121      50      112
##   tom.txt           0       0     0          0        5   27       0        0
##              features
## docs          Brüstner Jemand
##   prozess.txt        1      2
##   tom.txt            0      1
## [ reached max_nfeat ... 10,062 more features ]

6.10 Besedni oblaček 

textplot_wordcloud(matrika_lem, comparison = TRUE, adjust = 0.3, color = c("darkblue","darkgreen"),
                   max_size = 4, min_size = 0.75, rotation = 0.5, min_count = 30, max_words = 250)

Lepši oblaček (za obe besedili skupaj).

# install.packages("wordcloud2)
matrika_lem_prozess = matrika_lem[1,]

set.seed(1320)
library(wordcloud2)
topfeat <- as.data.frame(topfeatures(matrika_lem_prozess, 100))
topfeat <- rownames_to_column(topfeat, var = "word")
wordcloud2(topfeat)
matrika_lem_tom = matrika_lem[2,]

set.seed(1321)
library(wordcloud2)
topfeat2 <- as.data.frame(topfeatures(matrika_lem_tom, 100))
topfeat2 <- rownames_to_column(topfeat2, var = "word")
wordcloud2(topfeat2)

6.11 Položaj v besedilu (xray)

Diagram prikazuje, kje v besedilih se pojavlja besedna oblika “frau”. Podobno: Voyant Tools (MicroSearch).

kwic_frau = kwic(lemmas, pattern = "frau")
textplot_xray(kwic_frau)

6.12 Slovarska raznolikost 

textstat_lexdiv(matrika, measure = "all")
##      document       TTR         C        R     CTTR        U         S        K
## 1 prozess.txt 0.2457355 0.8651285 44.68334 31.59590 33.50861 0.9039511 22.63899
## 2     tom.txt 0.2939104 0.8828536 54.69657 38.67631 38.75057 0.9176397 11.76995
##          I           D         Vm      Maas     lgV0    lgeV0
## 1 26.76129 0.002233722 0.04626902 0.1727515 7.795478 17.94975
## 2 73.92612 0.001148154 0.03284439 0.1606427 8.533417 19.64892

6.13 Podobnost besedil

Ta postopek je bolj zanimiv, če želimo primerjati več besedil. Zato bomo dodali še Kafkino novelo.

# odpremo datoteko
verwandl = readtext("data/books/verwandlung/verwandlung.txt", encoding = "UTF-8")
# ustvarimo nov korpus
verw_corp = corpus(verwandl)
# združimo novi korpus s prrejšnjim
romane3 = romane + verw_corp
# tokenizacija
romane3_toks = tokens(romane3)
# ustvarimo matriko (dfm)
romane3_dfm = dfm(romane3_toks)

Rezultat: Kafkina novela “Die Verwandlung” je Kafkinemu romanu “Der Prozess” nekoliko podobnejša kot Twainov roman “Tom Sawyer”.

textstat_simil(romane3_dfm, method = "cosine", margin = "documents")
## textstat_simil object; method = "cosine"
##                 prozess.txt tom.txt verwandlung.txt
## prozess.txt           1.000   0.930           0.948
## tom.txt               0.930   1.000           0.933
## verwandlung.txt       0.948   0.933           1.000

Podobnost oblik (features).

# compute some term similarities
simil1 = textstat_simil(matrika, matrika[, c("Josef", "Tom", "Sawyer", "Huck", "Finn")], 
                         method = "cosine", margin = "features")
head(as.matrix(simil1), 10)
##                Josef       Tom    Sawyer      Huck      Finn
## Prozess    0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Franz      0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Kafka      0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Verhaftung 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Gespräch   0.9793983 0.2425356 0.2425356 0.2425356 0.2425356
## Frau       0.9933995 0.1559626 0.1559626 0.1559626 0.1559626
## Grubach    0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Fräulein   0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Brüstner   0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Jemand     0.9122695 0.4472136 0.4472136 0.4472136 0.4472136

Različnost besedil (Kaj je ta metoda upoštevala? Razliko v dolžini?):

# plot a dendrogram after converting the object into distances
dist1 = textstat_dist(romane3_dfm, method = "euclidean", margin = "documents")
plot(hclust(as.dist(dist1)))

6.14 Ključne besede

Katere besedne oblike lahko uvrstimo med ključne besede, tj. take izraze, ki so najbolj značilni za neko besedilo? Program quanteda ima funkcijo textstat_keyness(): ciljno besedilo (target) primerjamo z referenčnim besedilom (reference).

key_tom <- textstat_keyness(matrika, target = "tom.txt")
key_tom %>% rmarkdown::paged_table()
key_prozess <- textstat_keyness(matrika, target = "prozess.txt")
key_prozess %>% rmarkdown::paged_table()
textplot_keyness(key_tom, key_tom$n_target == 1)
## Warning in if (show_reference) {: the condition has length > 1 and only the
## first element will be used
## Warning in if (show_reference) {: the condition has length > 1 and only the
## first element will be used
## Warning in if (show_reference) {: the condition has length > 1 and only the
## first element will be used
## Warning in if (show_reference) min(data$x1) - margin else 0: the condition has
## length > 1 and only the first element will be used
textplot_keyness(key_tom, key_prozess$n_target == 1)
## Warning in if (show_reference) {: the condition has length > 1 and only the
## first element will be used
## Warning in if (show_reference) {: the condition has length > 1 and only the
## first element will be used
## Warning in if (show_reference) {: the condition has length > 1 and only the
## first element will be used
## Warning in if (show_reference) min(data$x1) - margin else 0: the condition has
## length > 1 and only the first element will be used
textplot_keyness(key_prozess)

6.15 Razumljivost besedil

Indeksi razumljivosti (readability index) so prirejeni za angleščino, za druge jezike veljajo v manjši meri.

Flesch-Indeks: Prozess ima nekoliko nižjo vrednost (52) kot Tom Sawyer (61), kar pomeni, da Prozess (zaradi daljših povedi in besed) težje beremo (razumemo), Tom Sawyer pa z večjo lahkoto.

textstat_readability(romane, measure = c("Flesch", "Flesch.Kincaid", "FOG", "FOG.PSK", "FOG.NRI"))
##      document   Flesch Flesch.Kincaid      FOG  FOG.PSK  FOG.NRI
## 1 prozess.txt 51.94715      10.644645 13.04497 6.390374 8545.508
## 2     tom.txt 60.58142       8.395483 10.61185 5.074038 6016.218

6.16 Omrežje sopojavitev (FCM)

Matriko sopojavljanja besednih oblik (FCM) pridobimo v dveh korakih: - najprej izberemo seznam izrazov (pattern) iz matrike (dfm), - potem določimo matriko sopojavljanja besednih oblik (fcm).

dfm_tags <- dfm_select(matrika[2,], pattern = (c("tom", "huck", "*joe", "becky", "tante", "witwe",
                                                 "polly", "sid", "mary", "thatcher", "höhle", "herz",
                                                 "*schule", "katze", "geld", "zaun", "piraten",
                                                 "schatz")))
toptag <- names(topfeatures(dfm_tags, 50))
head(toptag)
## [1] "Tom"   "Huck"  "Joe"   "Becky" "Tante" "Sid"
# Construct feature-cooccurrence matrix (fcm) of tags
fcm_tom <- fcm(matrika[2,]) # besedilo 2 je tom.txt
head(fcm_tom)
## Feature co-occurrence matrix of: 6 by 15,185 features.
##             features
## features     Prozess Franz Kafka Verhaftung Gespräch Frau Grubach Fräulein
##   Prozess          0     0     0          0        0    0       0        0
##   Franz            0     0     0          0        0    0       0        0
##   Kafka            0     0     0          0        0    0       0        0
##   Verhaftung       0     0     0          0        0    0       0        0
##   Gespräch         0     0     0          0        6   72       0        0
##   Frau             0     0     0          0        0  153       0        0
##             features
## features     Brüstner Jemand
##   Prozess           0      0
##   Franz             0      0
##   Kafka             0      0
##   Verhaftung        0      0
##   Gespräch          0      4
##   Frau              0     18
## [ reached max_nfeat ... 15,175 more features ]
top_fcm <- fcm_select(fcm_tom, pattern = toptag)
textplot_network(top_fcm, min_freq = 0.6, edge_alpha = 0.8, edge_size = 5)

6.17 Slovnična analiza

Za slovnično analizo in lematizacijo besednih oblik lahko uporabljamo posebne programe (npr. spacyr ali udpipe).

Program udpipe je na voljo za številne jezike, tudi za nemščino in slovenščino.

6.17.1 Priprava

Pred prvo uporabo moramo naložiti model za nemški jezik z interneta.

library(udpipe)
sprachmodell <- udpipe_download_model(language = "german")
## Downloading udpipe model from https://raw.githubusercontent.com/jwijffels/udpipe.models.ud.2.5/master/inst/udpipe-ud-2.5-191206/german-gsd-ud-2.5-191206.udpipe to D:/Users/teodo/Documents/R/raj2022-book/german-gsd-ud-2.5-191206.udpipe
##  - This model has been trained on version 2.5 of data from https://universaldependencies.org
##  - The model is distributed under the CC-BY-SA-NC license: https://creativecommons.org/licenses/by-nc-sa/4.0
##  - Visit https://github.com/jwijffels/udpipe.models.ud.2.5 for model license details.
##  - For a list of all models and their licenses (most models you can download with this package have either a CC-BY-SA or a CC-BY-SA-NC license) read the documentation at ?udpipe_download_model. For building your own models: visit the documentation by typing vignette('udpipe-train', package = 'udpipe')
## Downloading finished, model stored at 'D:/Users/teodo/Documents/R/raj2022-book/german-gsd-ud-2.5-191206.udpipe'

V naslednjem koraku naložimo jezikovni model v pomnilnik.

udmodel_de <- udpipe_load_model(sprachmodell$file_model)

Če je jezikovni model že v naši delovni mapi, download ni potreben, saj ga lahko takoj naložimo z diska v pomnilnik.

file_model = "german-gsd-ud-2.5-191206.udpipe"
udmodel_de <- udpipe_load_model(file_model)

Naslednji korak je udpipe_annotate(): program udpipe označuje besedne oblike po več merilih.

Udpipe prebere in označuje besedilo takole:

# Na začetku je readtext prebral besedila, shranili smo jih v spremenljivki "txt".
x <- udpipe_annotate(udmodel_de, x = txt$text, trace = TRUE)
## 2021-08-19 23:23:10 Annotating text fragment 1/2
## 2021-08-19 23:25:03 Annotating text fragment 2/2
# # samo prvo besedilo:
# x <- udpipe_annotate(udmodel_de, x = txt$text[1], trace = TRUE)

x <- as.data.frame(x)

Zgradba podatkovnega niza (structure of data frame):

str(x)
## 'data.frame':    174925 obs. of  14 variables:
##  $ doc_id       : chr  "doc1" "doc1" "doc1" "doc1" ...
##  $ paragraph_id : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ sentence_id  : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ sentence     : chr  "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ ...
##  $ token_id     : chr  "1" "2" "3" "4" ...
##  $ token        : chr  "Der" "Prozess" "by" "Franz" ...
##  $ lemma        : chr  "der" "Prozeß" "by" "Franz" ...
##  $ upos         : chr  "DET" "NOUN" "PROPN" "PROPN" ...
##  $ xpos         : chr  "ART" "NN" "NE" "NE" ...
##  $ feats        : chr  "Case=Nom|Definite=Def|Gender=Masc|Number=Sing|PronType=Art" "Case=Nom|Gender=Masc|Number=Sing" "Case=Nom|Gender=Masc|Number=Sing" "Case=Nom|Gender=Masc|Number=Sing" ...
##  $ head_token_id: chr  "2" "72" "2" "3" ...
##  $ dep_rel      : chr  "det" "nsubj" "appos" "flat" ...
##  $ deps         : chr  NA NA NA NA ...
##  $ misc         : chr  NA NA NA NA ...

Podatkovni niz ima tako obliko:

head(x, 10) %>% rmarkdown::paged_table()

6.17.2 Primerjava Noun : Pron

Zdaj lahko začnemo poizvedovati po besednih oblikah, slovarskih enotah in slovničnih kategorijah.

(tabela = x %>% 
  group_by(doc_id) %>% 
  count(upos) %>% 
  filter(!is.na(upos),
         upos != "PUNCT")
)
## # A tibble: 28 x 3
## # Groups:   doc_id [2]
##    doc_id upos      n
##    <chr>  <chr> <int>
##  1 doc1   ADJ    5284
##  2 doc1   ADP    6350
##  3 doc1   ADV    8387
##  4 doc1   AUX    4390
##  5 doc1   CCONJ  2425
##  6 doc1   DET    8050
##  7 doc1   NOUN  10705
##  8 doc1   NUM     155
##  9 doc1   PART   1984
## 10 doc1   PRON  11280
## # ... with 18 more rows
tabela %>% 
  mutate(upos = reorder_within(upos, n, n, sep = ": ")) %>% 
  ggplot(aes(n, upos, fill = upos)) +
  geom_col() +
  facet_wrap(~ doc_id, scales = "free") +
  theme(legend.position = "none") +
  labs(x = "Število pojavnic", y = "")

Izračun deležev v odstotkih:

(delezi = tabela %>% 
  mutate(prozent = n/sum(n)) %>% 
  pivot_wider(id_cols = upos, names_from = doc_id, values_from = n:prozent)
)
## # A tibble: 14 x 5
##    upos  n_doc1 n_doc2 prozent_doc1 prozent_doc2
##    <chr>  <int>  <int>        <dbl>        <dbl>
##  1 ADJ     5284   5539     0.0729        0.0818 
##  2 ADP     6350   5524     0.0877        0.0816 
##  3 ADV     8387   6706     0.116         0.0990 
##  4 AUX     4390   3386     0.0606        0.0500 
##  5 CCONJ   2425   3270     0.0335        0.0483 
##  6 DET     8050   6888     0.111         0.102  
##  7 NOUN   10705  10871     0.148         0.160  
##  8 NUM      155    306     0.00214       0.00452
##  9 PART    1984   1658     0.0274        0.0245 
## 10 PRON   11280   9027     0.156         0.133  
## 11 PROPN   2317   3919     0.0320        0.0579 
## 12 SCONJ   1687   1296     0.0233        0.0191 
## 13 VERB    9401   8669     0.130         0.128  
## 14 X         20    678     0.000276      0.0100
delezi %>% 
  filter(upos %in% c("NOUN", "PRON"))
## # A tibble: 2 x 5
##   upos  n_doc1 n_doc2 prozent_doc1 prozent_doc2
##   <chr>  <int>  <int>        <dbl>        <dbl>
## 1 NOUN   10705  10871        0.148        0.160
## 2 PRON   11280   9027        0.156        0.133

Ali se besedili razlikujeta glede na razmerje med samostalniki in zaimki?

# za hi kvadrat test potrebujemo le drugi in tretji stolpec
nominal = delezi %>% 
  filter(upos %in% c("NOUN", "PRON")) %>% 
  dplyr::select(n_doc1, n_doc2) 

chisq.test(nominal)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  nominal
## X-squared = 147.38, df = 1, p-value < 2.2e-16

Besedili se razlikujeta glede razmerja med samostalniki in zaimki: X^2 (1) = 147,38; p < 0,001. Iz gornje tabele pogostnosti je razvidno, da je delež zaimkov v romanu “Prozess” sorazmerno večji kot v romanu “Tom Sawyer”. Da bi ugotovili, kaj to pomeni, bi si morali podrobneje ogledati, kateri zaimki in kateri samostalniki bistveno vplivajo na to številčno razmerje. Na splošno velja, da so zaimki manj zanesljiva jezikovna sredstva kot samostalniki, samostalniki pa so bolj zapleteni.

Če želimo primerjati eno besedno vrsto z vsemi drugimi v podatkovnem nizu, je pretvorba bolj zapletena, saj moramo podobno kot v Excelu - najprej izračunati vsoto za vse besedne vrste, - potem odšteti število zaimkov oz. samostalnikov od vsote, - razliko pa upoštevati za tabelo 2x2 za hi kvadrat test.

(zaimki = x %>% 
  group_by(doc_id) %>% 
  count(upos) %>% 
  filter(!is.na(upos),
         upos != "PUNCT") %>% 
  mutate(vsota = sum(n),
         no_noun = vsota - n[upos == "NOUN"],
         no_pron = vsota - n[upos == "PRON"]) %>% 
  filter(upos == "PRON") %>% 
  dplyr::select(doc_id, n, no_pron) %>% 
  pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
  pivot_wider(kategorija, doc_id)
)
## # A tibble: 2 x 3
##   kategorija  doc1  doc2
##   <chr>      <int> <int>
## 1 n          11280  9027
## 2 no_pron    61155 58710
(samostalniki = x %>% 
  group_by(doc_id) %>% 
  count(upos) %>% 
  filter(!is.na(upos),
         upos != "PUNCT") %>% 
  mutate(vsota = sum(n),
         no_noun = vsota - n[upos == "NOUN"],
         no_pron = vsota - n[upos == "PRON"]) %>% 
  filter(upos == "NOUN") %>% 
  dplyr::select(doc_id, n, no_noun) %>% 
  pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
  pivot_wider(kategorija, doc_id)
)
## # A tibble: 2 x 3
##   kategorija  doc1  doc2
##   <chr>      <int> <int>
## 1 n          10705 10871
## 2 no_noun    61730 56866

Hi kvadrat testa: - primerjava števila zaimkov nasproti ostalim besednim vrstam, - primerjava števila samostalnikov nasproti ostalim besednim vrstam.

# izločimo prvi stolpec [, -1], za hi kvadrat test potrebujemo le drugi in tretji stolpec
chisq.test(zaimki[,-1])
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  zaimki[, -1]
## X-squared = 142.36, df = 1, p-value < 2.2e-16
chisq.test(samostalniki[,-1])
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  samostalniki[, -1]
## X-squared = 43.259, df = 1, p-value = 4.796e-11

Besedili se razlikujeta glede deleža zaimkov in samostalnikov.

6.17.3 Primerjava veznikov

Primerjati želimo število stavkov s prirednim in podrednim veznikom.

Osnovna domneva je, da priredno zložene povedi (vsebujejo stavek, uveden s prirednim veznikom) lažje razumemo kot podredno zložene povedi (vsebujejo stavek, uveden s podrednim veznikom).

(vezniki = tabela %>% 
  filter(upos %in% c("CCONJ", "SCONJ")) %>% 
  mutate(prozent = n/sum(n)) %>% 
  pivot_wider(id_cols = upos, names_from = doc_id, values_from = n:prozent)
)
## # A tibble: 2 x 5
##   upos  n_doc1 n_doc2 prozent_doc1 prozent_doc2
##   <chr>  <int>  <int>        <dbl>        <dbl>
## 1 CCONJ   2425   3270        0.590        0.716
## 2 SCONJ   1687   1296        0.410        0.284

Odstotki nakazujejo, da je v romanu Prozess delež prirednih veznikov manjši kot v romanu Tom Sawyer.

Hi kvadrat test (upoštevane so le povedi, ki vsebujejo veznik) za preverjanje, ali je razlika dovolj velika, da bi bila nenaključna.

chisq.test(vezniki[,c(2:3)])
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  vezniki[, c(2:3)]
## X-squared = 152.74, df = 1, p-value < 2.2e-16

Razlika med romanoma je statistično značilna.

Če upoštevamo tudi vsote drugih besednih vrst (kot zgoraj):

(koord = tabela %>% 
  mutate(vsota = sum(n),
         no_cconj = vsota - n[upos == "CCONJ"],
         no_sconj = vsota - n[upos == "SCONJ"]) %>% 
  filter(upos == "CCONJ") %>% 
  dplyr::select(doc_id, n, no_cconj) %>% 
  pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
  pivot_wider(kategorija, doc_id)
)
## # A tibble: 2 x 3
##   kategorija  doc1  doc2
##   <chr>      <int> <int>
## 1 n           2425  3270
## 2 no_cconj   70010 64467
(subord = tabela %>% 
  mutate(vsota = sum(n),
         no_cconj = vsota - n[upos == "CCONJ"],
         no_sconj = vsota - n[upos == "SCONJ"]) %>% 
  filter(upos == "SCONJ") %>% 
  dplyr::select(doc_id, n, no_sconj) %>% 
  pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
  pivot_wider(kategorija, doc_id)
)
## # A tibble: 2 x 3
##   kategorija  doc1  doc2
##   <chr>      <int> <int>
## 1 n           1687  1296
## 2 no_sconj   70748 66441

Hi kvadrat preizkus izkazuje razliko med romanoma

chisq.test(koord[,-1])
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  koord[, -1]
## X-squared = 196.24, df = 1, p-value < 2.2e-16
chisq.test(subord[,-1])
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  subord[, -1]
## X-squared = 28.843, df = 1, p-value = 7.849e-08

Besedili se razlikujeta glede števila veznikov.

6.17.4 Slovarske enote

Program udpipe je vsako besedno obliko dodelil slovarski enoti (lemma). Koliko koliko slovarskih enot je v besedilih? Katerim besednim vrstam najpogosteje pripadajo?

(tabela2 = x %>% 
  group_by(doc_id, upos) %>% 
    filter(!is.na(upos),
           upos != "PUNCT",
           upos != "X") %>% 
  distinct(lemma) %>% 
  count(lemma) %>% 
  summarise(lemmas = sum(n)) %>% 
  mutate(prozent = round(lemmas/sum(lemmas), 4)) %>% 
  arrange(-prozent)
)
## `summarise()` has grouped output by 'doc_id'. You can override using the `.groups` argument.
## # A tibble: 26 x 4
## # Groups:   doc_id [2]
##    doc_id upos  lemmas prozent
##    <chr>  <chr>  <int>   <dbl>
##  1 doc2   NOUN    3401  0.361 
##  2 doc1   NOUN    2519  0.352 
##  3 doc1   VERB    1696  0.237 
##  4 doc1   ADJ     1528  0.213 
##  5 doc2   VERB    1934  0.206 
##  6 doc2   ADJ     1875  0.199 
##  7 doc2   PROPN    973  0.103 
##  8 doc1   ADV      605  0.0845
##  9 doc2   ADV      671  0.0713
## 10 doc1   PROPN    387  0.054 
## # ... with 16 more rows
tabela2 %>% 
  # slice_max(order_by = prozent, n=6) %>% 
  mutate(upos = reorder_within(upos, lemmas, paste("(",100*prozent,"%)"), sep = " ")) %>%
  ggplot(aes(prozent, upos, fill = upos)) +
  geom_col() +
  facet_wrap(~ doc_id, scales = "free") +
  theme(legend.position = "none") +
  scale_x_continuous(labels = percent_format()) +
  labs(x = "Anteil", y = "Wortklasse")

6.17.5 Korelacija besed

Katere besedne pogostnosti se vzporedno povečujejo ali zmanjšujejo (pairwise correlation) ? Podobno analizno orodje: Voyant Tools.

library(widyr)

# pairwise correlation
(correlations = x %>% 
  filter(dep_rel != "punct", dep_rel != "nummod") %>%
  mutate(lemma = tolower(lemma), token = tolower(token),
         lemma = str_trim(lemma), token = str_trim(token)) %>% 
  janitor::clean_names() %>%
  group_by(doc_id, lemma, token, sentence_id) %>% 
  # add_count(token) %>% 
  summarize(Freq = n()) %>% 
  arrange(-Freq) %>% 
  filter(Freq > 2) %>% 
  pairwise_cor(lemma, sentence_id, sort = TRUE) %>% 
  filter(correlation < 1 & correlation > 0.3)
)
## `summarise()` has grouped output by 'doc_id', 'lemma', 'token'. You can override using the `.groups` argument.
## # A tibble: 2,592 x 3
##    item1          item2          correlation
##    <chr>          <chr>                <dbl>
##  1 verteidigung   natürlich            0.865
##  2 natürlich      verteidigung         0.865
##  3 stellvertreter direktor             0.812
##  4 direktor       stellvertreter       0.812
##  5 bürstner       fräulein             0.741
##  6 fräulein       bürstner             0.741
##  7 master         jim                  0.706
##  8 depot          jim                  0.706
##  9 eimer          jim                  0.706
## 10 glaskugel      jim                  0.706
## # ... with 2,582 more rows

Tom Sawyer: Zaun.

correlations %>%
  filter(item1 == "zaun") %>%
  mutate(item2 = fct_reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation, fill = item2)) +
  geom_col(show.legend = F) +
  coord_flip() +
  labs(title = "What tends to appear with 'Zaun'?",
       subtitle = "Among elements that appeared in at least 2 sentences")

Prozess: Gericht.

correlations %>%
  filter(item1 == "gericht") %>%
  mutate(item2 = fct_reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation, fill = item2)) +
  geom_col(show.legend = F) +
  coord_flip() +
  labs(title = "What tends to appear with 'Gericht'?",
       subtitle = "Among elements that appeared in at least 2 sentences")

6.18 Sentiment

Stopnjo čustvenosti ali emocionalnosti besedila je mogoče določiti s sentimentnim slovarjem.

6.18.1 Različica 1

Uporaba nrc leksikona za nemščino (priložen programu syuzhet).

Najprej besedilo s funkcijo get_sentences() razcepimo na povedi.

library(syuzhet)

tom_v = get_sentences(txt$text[2]) # izberemo drugo besedilo: tom.txt
tom_v = (tom_v[-1]) # tako lahko izločimo prvo vrstico (uredniško pripombo)
head(tom_v[-1])
## [1] "Das eine oder das andere habe ich selbst erlebt , die anderen meine Schulkameraden ."                                                                                                                                                                                                                                                                                                   
## [2] "Huck Finn ist nach dem Leben gezeichnet , nicht weniger Tom Sawyer , doch entspricht dieser nicht einer bestimmten Persönlichkeit , sondern wurde mit charakteristischen Zügen mehrerer meiner Altersgenossen ausgestattet und darf daher jenem gegenüber als einigermaßen kompliziertes psychologisches Problem gelten ."                                                              
## [3] "Ich muß hier bemerken , daß zur Zeit meiner Erzählung -- vor dreißig bis vierzig Jahren -- unter den Unmündigen und Unwissenden des Westens noch die seltsamsten , unwahrscheinlichsten Vorurteile und Aberglauben herrschten ."                                                                                                                                                        
## [4] "Obwohl dies Buch vor allem zur Unterhaltung der kleinen Welt geschrieben wurde , so darf ich doch wohl hoffen , daß es auch von Erwachsenen nicht ganz unbeachtet gelassen werde , habe ich doch darin versucht , ihnen auf angenehme Weise zu zeigen , was sie einst selbst waren , wie sie fühlten , dachten , sprachen , und welcher Art ihr Ehrgeiz und ihre Unternehmungen waren ."
## [5] "Erstes Kapitel ."                                                                                                                                                                                                                                                                                                                                                                       
## [6] ", ,Tom !"

Funkcija get_sentiment() dodeli besedam v povedih pozitivno (+1), negativno (-1) ali nevtralno (0) čustveno vrednost. Program te vrednosti sešteje.

tom_values <- get_sentiment(tom_v, method = "nrc", language = "german")
length(tom_values)
## [1] 5047
tom_values[100:110]
##  [1]  0 -2  0  1  0  1  0  0  0  0  0

Povedi, čustvene vrednosti in dolžino povedi povežemo v podatkovni niz. To nam olajšuje oceno, kako uspešna je bila uporaba sentimentnega slovarja v našem besedilu. Preimenovali bomo tudi nekaj stolpcev.

sentiment1 = cbind(tom_v, tom_values, ntoken(tom_v)) %>% 
  as.data.frame() %>% 
  rename(words = V3,
         text = tom_v,
         values = tom_values) %>% 
  mutate(doc_id = "tom.txt") %>% 
  rowid_to_column(var = "sentence")

# View(sentiment1)
sentiment1 %>% rmarkdown::paged_table()

Gornje postopke ponovimo za besedilo, ki ga želimo primerjati s prvim.

prozess_v = get_sentences(txt$text[1]) # izberemo prvo besedilo: prozess.txt
prozess_v = (prozess_v[-1]) # tako lahko izločimo prvo vrstico (uredniško pripombo)
prozess_values <- get_sentiment(prozess_v, method = "nrc", language = "german")
sentiment2 = cbind(prozess_v, prozess_values, ntoken(prozess_v)) %>% 
  as.data.frame() %>% 
  rename(words = V3,
         text = prozess_v,
         values = prozess_values) %>% 
  mutate(doc_id = "prozess.txt") %>% 
  rowid_to_column(var = "sentence")

# View(sentiment2)
sentiment2 %>% rmarkdown::paged_table()

S seštevanjem čustvenih vrednosti je mogoče oceniti, katero besedilo ima več pozitivno ocenjenih besed. V ta namen bomo združili podatkovna niza in uredili obliko stolpcev “words” in “values”.

sentiment = rbind(sentiment1, sentiment2) %>% as_tibble() %>% 
  mutate(values = parse_number(values),
         words = parse_number(words)) %>%
  dplyr::select(doc_id, sentence, words, values, text)

sentiment %>% rmarkdown::paged_table()

Rezultat: po gornji metodi je povprečje čustvenih vrednosti v romanu “Prozess” nekoliko večje kot v romanu “Tom Sawyer”. To je v nasprotju z našim pričakovanjem, saj Tom Sawyer vsebuje kar nekaj vedrih zgodb, je pa res, da so njegove pustolovščine pogosto tudi nevarne ali strašljive.

sentiment %>% 
  group_by(doc_id) %>% 
  summarise(polarnost = mean(values))
## # A tibble: 2 x 2
##   doc_id      polarnost
##   <chr>           <dbl>
## 1 prozess.txt    0.0550
## 2 tom.txt       -0.0109

Poskusimo drugače: pozitivne, nevtralne in negativne vrednosti obravnajmo ločeno in upoštevajmo tudi dolžino povedi.

sentiment1 = sentiment %>% 
  group_by(doc_id) %>% 
  mutate(positive = ifelse(values > 0, abs(values), 0),
         neutral = ifelse(values == 0, 1, 0),
         negative = ifelse(values < 0, abs(values), 0))
sentiment1 %>% 
  summarise(pos = mean(100*positive/words),
            neut = mean(100*neutral/words),
            neg = mean(100*negative/words))
## # A tibble: 2 x 4
##   doc_id        pos  neut   neg
##   <chr>       <dbl> <dbl> <dbl>
## 1 prozess.txt  2.30  4.34  2.13
## 2 tom.txt      2.63  6.77  2.81

Ta rezultat je skladnejši z našim pričakovanjem.

Poglejmo še nekaj povedi, ki so bile ocenjene negativno:

sentiment1 %>% 
  filter(negative > 0) %>% 
  rmarkdown::paged_table()

6.18.2 Različica 2 

tom_v = get_sentences(txt$text[2])
tom_nrc_values = get_nrc_sentiment(tom_v)
tom_joy_items = which(tom_nrc_values$joy > 0)
head(tom_v[tom_joy_items], 4)
## [1] "Obwohl dies Buch vor allem zur Unterhaltung der kleinen Welt geschrieben wurde , so darf ich doch wohl hoffen , daß es auch von Erwachsenen nicht ganz unbeachtet gelassen werde , habe ich doch darin versucht , ihnen auf angenehme Weise zu zeigen , was sie einst selbst waren , wie sie fühlten , dachten , sprachen , und welcher Art ihr Ehrgeiz und ihre Unternehmungen waren ."
## [2] ", Spare die Rute , und du verdirbst dein Kind ' , heißt es ."                                                                                                                                                                                                                                                                                                                           
## [3] "Er ist meiner toten Schwester Kind , ein armes Kind , und ich habe nicht das Herz , ihn irgendwie am Gängelband zu führen ."                                                                                                                                                                                                                                                            
## [4] "Es ist wohl hart für ihn , am Samstag stillzusitzen , wenn alle anderen Knaben Feiertag haben , aber er haßt Arbeit mehr als irgend sonst was , und ich will meine Pflicht an ihm tun , oder ich würde das Kind zu Grunde richten ."
nrc_sentiment = as.data.frame(cbind(tom_v, tom_nrc_values))
nrc_sentiment %>% rmarkdown::paged_table()

6.18.3 Različica 3

Drugi sentimentni slovarji z medmrežja: npr. BAWLR lahko uporabljamo kot sentimentni slovar.

# This lexicons contains values of Emotional valence and arousal ranging from 1 to 5.
# But this extended version contains also binary Emo_Val values (1, -1).
bawlr <- read.delim2("data/BAWLR_utf8.txt", sep = "\t", dec = ",", fileEncoding = "UTF-8", 
                     header = T, stringsAsFactors = T)
# # bawlr$EmoVal <- as.character(bawlr$EmoVal)
# # str(EmoVal)
# bawlr$EmoVal <- gsub('NEG', '-1', bawlr$EmoVal)
# bawlr$EmoVal <- gsub('POS', '1', bawlr$EmoVal)
# bawlr$EmoVal <- as.numeric(bawlr$EmoVal)
bawlr %>% rmarkdown::paged_table()

Sestavimo dva seznama:

positive.words = bawlr %>% 
  mutate(WORD_LOWER = as.character(WORD_LOWER)) %>% 
  dplyr::select(EmoVal, WORD_LOWER) %>% 
  filter(EmoVal == "POS") %>% 
  dplyr::select(WORD_LOWER) %>% 
  filter(str_detect(WORD_LOWER, "[a-zA-Z]"))

negative.words = bawlr %>% 
  mutate(WORD_LOWER = as.character(WORD_LOWER)) %>% 
  dplyr::select(EmoVal, WORD_LOWER) %>% 
  filter(EmoVal == "NEG") %>% 
  dplyr::select(WORD_LOWER) %>% 
  filter(str_detect(WORD_LOWER, "[a-zA-Z]"))

Ustvarimo quanteda slovar dictionary():

bawlr_dict = dictionary(list(positive = list(positive.words), negative = list(negative.words)))

Uporabljamo matriko (dfm) s slovarskimi enotami (lemma), saj slovar bawlr_dict vsebujejo le osnovno obliko slovarskih enot.

matrika_lemmas = dfm(matrika_lem, tolower = TRUE)

result = matrika_lemmas %>% 
  dfm_lookup(bawlr_dict) %>% 
  convert(to = "data.frame") %>% 
  as_tibble
result
## # A tibble: 2 x 3
##   doc_id      positive negative
##   <chr>          <dbl>    <dbl>
## 1 prozess.txt 10540540  5856000
## 2 tom.txt      9183068  5425584

Dodamo lahko skupno dolžino besed, če želimo normalizirati rezultat z ozirom na dolžino besedil.

result = result %>% mutate(length=ntoken(matrika_lemmas))
result
## # A tibble: 2 x 4
##   doc_id      positive negative length
##   <chr>          <dbl>    <dbl>  <int>
## 1 prozess.txt 10540540  5856000  32058
## 2 tom.txt      9183068  5425584  33520

Po navadi želimo izračunati skupni sentimentno vrednost. Možnosti je več: npr. - odšteti negativne vrednosti od pozitivnih in nato razliko deliti z vsoto obeh vrednosti, - odšteti negativne vrednosti od pozitivnih in nato razliko deliti z dolžino besedil,

Izračunamo lahko tudi stopnjo subjektivnosti, tj. koliko čustvenih vrednosti je skupno izraženih:

result = result %>% mutate(sentiment1=(positive - negative) / (positive + negative))
result = result %>% mutate(sentiment2=(positive - negative) / length)
result = result %>% mutate(subjektivnost=(positive + negative) / length)
result %>% rmarkdown::paged_table()

6.18.3.1 Barvno označevanje

Program corpustools barvno označuje besede v besedilih z ozirom na čustvene vrednosti besed v sentimentnem slovarju.

Prvi korak je ustvarjanje tcorpusa.

library(corpustools)
t = create_tcorpus(txt, doc_column="doc_id")

V drugem koraku sledi iskanje po slovarju (tcorpus):

t$code_dictionary(bawlr_dict, column = 'bawlr')
t$set('sentiment', 1, subset = bawlr %in% c('positive','neg_negative'))
t$set('sentiment', -1, subset = bawlr %in% c('negative','neg_positive'))

Prikaz barvno označenih besedil v oknu “Viewer”:

browse_texts(t, scale='sentiment')

Prikaz barvno označenih besedil v spletnem brskalniku in shranjevanje v obliki html datoteke:

browse_texts(t, scale='sentiment', filename = "sentiment_prozess_tom.html", 
             header = "Sentiment in Kafkas Prozess und Twains Tom Sawyer")